home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / sbin / dpkg-divert < prev    next >
Text File  |  2008-09-03  |  11KB  |  317 lines
  1. #!/usr/bin/perl --
  2.  
  3. BEGIN { # Work-around for bug #479711 in perl
  4.     $ENV{PERL_DL_NONLAZY} = 1;
  5. }
  6.  
  7. use strict;
  8. use warnings;
  9.  
  10. use POSIX qw(:errno_h);
  11. use Dpkg;
  12. use Dpkg::Gettext;
  13.  
  14. textdomain("dpkg");
  15.  
  16. sub version {
  17.     printf _g("Debian %s version %s.\n"), $progname, $version;
  18.  
  19.     printf _g("
  20. Copyright (C) 1995 Ian Jackson.
  21. Copyright (C) 2000,2001 Wichert Akkerman.");
  22.  
  23.     printf _g("
  24. This is free software; see the GNU General Public Licence version 2 or
  25. later for copying conditions. There is NO warranty.
  26. ");
  27. }
  28.  
  29. sub usage {
  30.     printf(_g(
  31. "Usage: %s [<option> ...] <command>
  32.  
  33. Commands:
  34.   [--add] <file>           add a diversion.
  35.   --remove <file>          remove the diversion.
  36.   --list [<glob-pattern>]  show file diversions.
  37.   --truename <file>        return the diverted file.
  38.  
  39. Options:
  40.   --package <package>      name of the package whose copy of <file> will not
  41.                              be diverted.
  42.   --local                  all packages' versions are diverted.
  43.   --divert <divert-to>     the name used by other packages' versions.
  44.   --rename                 actually move the file aside (or back).
  45.   --admindir <directory>   set the directory with the diversions file.
  46.   --test                   don't do anything, just demonstrate.
  47.   --quiet                  quiet operation, minimal output.
  48.   --help                   show this help message.
  49.   --version                show the version.
  50.  
  51. When adding, default is --local and --divert <original>.distrib.
  52. When removing, --package or --local and --divert must match if specified.
  53. Package preinst/postrm scripts should always specify --package and --divert.
  54. "), $progname);
  55. }
  56.  
  57. my $testmode = 0;
  58. my $dorename = 0;
  59. my $verbose = 1;
  60. my $mode = '';
  61. my $package = undef;
  62. my $divertto = undef;
  63. my @contest;
  64. my @altname;
  65. my @package;
  66. my $file;
  67. $|=1;
  68.  
  69.  
  70. # FIXME: those should be local.
  71. my ($rsrc, $rdest);
  72. my (@ssrc, @sdest);
  73.  
  74. sub checkmanymodes {
  75.     return unless $mode;
  76.     badusage(sprintf(_g("two commands specified: %s and --%s"), $_, $mode));
  77. }
  78.  
  79. while (@ARGV) {
  80.     $_= shift(@ARGV);
  81.     last if m/^--$/;
  82.     if (!m/^-/) {
  83.         unshift(@ARGV,$_); last;
  84.     } elsif (m/^--help$/) {
  85.         &usage; exit(0);
  86.     } elsif (m/^--version$/) {
  87.         &version; exit(0);
  88.     } elsif (m/^--test$/) {
  89.         $testmode= 1;
  90.     } elsif (m/^--rename$/) {
  91.         $dorename= 1;
  92.     } elsif (m/^--quiet$/) {
  93.         $verbose= 0;
  94.     } elsif (m/^--local$/) {
  95.         $package= ':';
  96.     } elsif (m/^--add$/) {
  97.         &checkmanymodes;
  98.         $mode= 'add';
  99.     } elsif (m/^--remove$/) {
  100.         &checkmanymodes;
  101.         $mode= 'remove';
  102.     } elsif (m/^--list$/) {
  103.         &checkmanymodes;
  104.         $mode= 'list';
  105.     } elsif (m/^--truename$/) {
  106.         &checkmanymodes;
  107.         $mode= 'truename';
  108.     } elsif (m/^--divert$/) {
  109.         @ARGV || &badusage(sprintf(_g("--%s needs a divert-to argument"), "divert"));
  110.         $divertto= shift(@ARGV);
  111.         $divertto =~ m/\n/ && &badusage(_g("divert-to may not contain newlines"));
  112.     } elsif (m/^--package$/) {
  113.         @ARGV || &badusage(sprintf(_g("--%s needs a <package> argument"), "package"));
  114.         $package= shift(@ARGV);
  115.         $package =~ m/\n/ && &badusage(_g("package may not contain newlines"));
  116.     } elsif (m/^--admindir$/) {
  117.         @ARGV || &badusage(sprintf(_g("--%s needs a <directory> argument"), "admindir"));
  118.         $admindir= shift(@ARGV);
  119.     } else {
  120.         &badusage(sprintf(_g("unknown option \`%s'"), $_));
  121.     }
  122. }
  123.  
  124. $mode='add' unless $mode;
  125.  
  126. open(O,"$admindir/diversions") || &quit(sprintf(_g("cannot open diversions: %s"), $!));
  127. while(<O>) {
  128.     s/\n$//; push(@contest,$_);
  129.     $_=<O>; s/\n$// || &badfmt(_g("missing altname"));
  130.     push(@altname,$_);
  131.     $_=<O>; s/\n$// || &badfmt(_g("missing package"));
  132.     push(@package,$_);
  133. }
  134. close(O);
  135.  
  136. if ($mode eq 'add') {
  137.     @ARGV == 1 || &badusage(sprintf(_g("--%s needs a single argument"), "add"));
  138.     $file= $ARGV[0];
  139.     $file =~ m#^/# || &badusage(sprintf(_g("filename \"%s\" is not absolute"), $file));
  140.     $file =~ m/\n/ && &badusage(_g("file may not contain newlines"));
  141.     -d $file && &badusage(_g("Cannot divert directories"));
  142.     $divertto= "$file.distrib" unless defined($divertto);
  143.     $divertto =~ m#^/# || &badusage(sprintf(_g("filename \"%s\" is not absolute"), $divertto));
  144.     $package= ':' unless defined($package);
  145.     for (my $i = 0; $i <= $#contest; $i++) {
  146.         if ($contest[$i] eq $file || $altname[$i] eq $file ||
  147.             $contest[$i] eq $divertto || $altname[$i] eq $divertto) {
  148.             if ($contest[$i] eq $file && $altname[$i] eq $divertto &&
  149.                 $package[$i] eq $package) {
  150.                 printf(_g("Leaving \`%s'")."\n", &infon($i)) if $verbose > 0;
  151.                 exit(0);
  152.             }
  153.             &quit(sprintf(_g("\`%s' clashes with \`%s'"), &infoa, &infon($i)));
  154.         }
  155.     }
  156.     push(@contest,$file);
  157.     push(@altname,$divertto);
  158.     push(@package,$package);
  159.     printf(_g("Adding \`%s'")."\n", &infon($#contest)) if $verbose > 0;
  160.     &checkrename($file,$divertto);
  161.     &save;
  162.     &dorename($file,$divertto);
  163.     exit(0);
  164. } elsif ($mode eq 'remove') {
  165.     @ARGV == 1 || &badusage(sprintf(_g("--%s needs a single argument"), "remove"));
  166.     $file= $ARGV[0];
  167.     for (my $i = 0; $i <= $#contest; $i++) {
  168.         next unless $file eq $contest[$i];
  169.         &quit(sprintf(_g("mismatch on divert-to\n  when removing \`%s'\n  found \`%s'"), &infoa, &infon($i)))
  170.               if defined($divertto) && $altname[$i] ne $divertto;
  171.         &quit(sprintf(_g("mismatch on package\n  when removing \`%s'\n  found \`%s'"), &infoa, &infon($i)))
  172.               if defined($package) && $package[$i] ne $package;
  173.         printf(_g("Removing \`%s'")."\n", &infon($i)) if $verbose > 0;
  174.         my $orgfile = $contest[$i];
  175.         my $orgdivertto = $altname[$i];
  176.         @contest= (($i > 0 ? @contest[0..$i-1] : ()),
  177.                    ($i < $#contest ? @contest[$i+1..$#contest] : ()));
  178.         @altname= (($i > 0 ? @altname[0..$i-1] : ()),
  179.                    ($i < $#altname ? @altname[$i+1..$#altname] : ()));
  180.         @package= (($i > 0 ? @package[0..$i-1] : ()),
  181.                    ($i < $#package ? @package[$i+1..$#package] : ()));
  182.     $dorename = 1;
  183.         &checkrename($orgdivertto,$orgfile);
  184.         &dorename($orgdivertto,$orgfile);
  185.         &save;
  186.         exit(0);
  187.     }
  188.     printf(_g("No diversion \`%s', none removed")."\n", &infoa) if $verbose > 0;
  189.     exit(0);
  190. } elsif ($mode eq 'list') {
  191.     my @list;
  192.     my @ilist = @ARGV ? @ARGV : ('*');
  193.     while (defined($_=shift(@ilist))) {
  194.         s/\W/\\$&/g;
  195.         s/\\\?/./g;
  196.         s/\\\*/.*/g;
  197.         push(@list,"^$_\$");
  198.     }
  199.     my $pat = join('|', @list);
  200.     for (my $i = 0; $i <= $#contest; $i++) {
  201.         next unless ($contest[$i] =~ m/$pat/o ||
  202.                      $altname[$i] =~ m/$pat/o ||
  203.                      $package[$i] =~ m/$pat/o);
  204.         print &infon($i),"\n";
  205.     }
  206.     exit(0);
  207. } elsif ($mode eq 'truename') {
  208.     @ARGV == 1 || &badusage(sprintf(_g("--%s needs a single argument"), "truename"));
  209.     $file= $ARGV[0];
  210.     for (my $i = 0; $i <= $#contest; $i++) {
  211.     next unless $file eq $contest[$i];
  212.     print $altname[$i], "\n";
  213.     exit(0);
  214.     }
  215.     print $file, "\n";
  216.     exit(0);
  217. } else {
  218.     &quit(sprintf(_g("internal error - bad mode \`%s'"), $mode));
  219. }
  220.  
  221. sub infol {
  222.     return ((defined($_[2]) ? ($_[2] eq ':' ? "local " : "") : "any ").
  223.             "diversion of $_[0]".
  224.             (defined($_[1]) ? " to $_[1]" : "").
  225.             (defined($_[2]) && $_[2] ne ':' ? " by $_[2]" : ""));
  226. }
  227.  
  228. sub checkrename {
  229.     return unless $dorename;
  230.     ($rsrc,$rdest) = @_;
  231.     (@ssrc= lstat($rsrc)) || $! == &ENOENT ||
  232.         &quit(sprintf(_g("cannot stat old name \`%s': %s"), $rsrc, $!));
  233.     (@sdest= lstat($rdest)) || $! == &ENOENT ||
  234.         &quit(sprintf(_g("cannot stat new name \`%s': %s"), $rdest, $!));
  235.     # Unfortunately we have to check for write access in both
  236.     # places, just having +w is not enough, since people do
  237.     # mount things RO, and we need to fail before we start
  238.     # mucking around with things. So we open a file with the
  239.     # same name as the diversions but with an extension that
  240.     # (hopefully) wont overwrite anything. If it succeeds, we
  241.     # assume a writable filesystem.
  242.     if (open (TMP, ">>", "${rsrc}.dpkg-devert.tmp")) {
  243.     close TMP;
  244.     unlink ("${rsrc}.dpkg-devert.tmp");
  245.     } elsif ($! == ENOENT) {
  246.     $dorename = !$dorename;
  247.     # If the source file is not present and we are not going to do the
  248.     # rename anyway there's no point in checking the target.
  249.     return;
  250.     } else {
  251.     quit(sprintf(_g("error checking \`%s': %s"), $rsrc, $!));
  252.     }
  253.  
  254.     if (open (TMP, ">>", "${rdest}.dpkg-devert.tmp")) {
  255.     close TMP;
  256.     unlink ("${rdest}.dpkg-devert.tmp");
  257.     } else {
  258.     quit(sprintf(_g("error checking \`%s': %s"), $rdest, $!));
  259.     }
  260.     if (@ssrc && @sdest &&
  261.         !($ssrc[0] == $sdest[0] && $ssrc[1] == $sdest[1])) {
  262.         &quit(sprintf(_g("rename involves overwriting \`%s' with\n".
  263.               "  different file \`%s', not allowed"), $rdest, $rsrc));
  264.     }
  265. }
  266.  
  267. sub dorename {
  268.     return unless $dorename;
  269.     return if $testmode;
  270.     if (@ssrc) {
  271.         if (@sdest) {
  272.             unlink($rsrc) || &quit(sprintf(_g("rename: remove duplicate old link \`%s': %s"), $rsrc, $!));
  273.         } else {
  274.             rename($rsrc,$rdest) || &quit(sprintf(_g("rename: rename \`%s' to \`%s': %s"), $rsrc, $rdest, $!));
  275.         }
  276.     }
  277. }            
  278.     
  279. sub save {
  280.     return if $testmode;
  281.     open(N,"> $admindir/diversions-new") || &quit(sprintf(_g("create diversions-new: %s"), $!));
  282.     chmod 0644, "$admindir/diversions-new";
  283.     for (my $i = 0; $i <= $#contest; $i++) {
  284.         print(N "$contest[$i]\n$altname[$i]\n$package[$i]\n")
  285.             || &quit(sprintf(_g("write diversions-new: %s"), $!));
  286.     }
  287.     close(N) || &quit(sprintf(_g("close diversions-new: %s"), $!));
  288.     unlink("$admindir/diversions-old") ||
  289.         $! == &ENOENT || &quit(sprintf(_g("remove old diversions-old: %s"), $!));
  290.     link("$admindir/diversions","$admindir/diversions-old") ||
  291.         $! == &ENOENT || &quit(sprintf(_g("create new diversions-old: %s"), $!));
  292.     rename("$admindir/diversions-new","$admindir/diversions")
  293.         || &quit(sprintf(_g("install new diversions: %s"), $!));
  294. }
  295.  
  296. sub infoa { &infol($file,$divertto,$package); }
  297. sub infon
  298. {
  299.     my $i = shift;
  300.     &infol($contest[$i], $altname[$i], $package[$i]);
  301. }
  302.  
  303. sub quit
  304. {
  305.     printf STDERR "%s: %s\n", $progname, "@_";
  306.     exit(2);
  307. }
  308.  
  309. sub badusage
  310. {
  311.     printf STDERR "%s: %s\n\n", $progname, "@_";
  312.     &usage;
  313.     exit(2);
  314. }
  315.  
  316. sub badfmt { &quit(sprintf(_g("internal error: %s corrupt: %s"), "$admindir/diversions", $_[0])); }
  317.